Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue32/kronos/KRONOS.ZIP/Main.pas

Pascal/Delphi Source File | 1998-02-22 | 20.4 KB | 737 lines

unit Main;
{
This program demonstrates some of the key features of TKronos:

***
It loads a daytype definition file containg data about authors and
display their birth and deaths in intervals of 25 years.

The daytype definition file also caontains a user calculated daytype
'My calcday' that is programmed to show up every last friday in a month.
If that friday happens to be a holiday, the first none holiday prior to
last friday is selected.

***

It implements basic functionality for navgigating a calendar.

***

It implements an interface for the user to edit, delete and add daytypes -
and to load and save daytype definitions to file.
}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Kronos, StdCtrls, Grids, Mask, ComCtrls, ExtCtrls;

type

  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    LabelMonthName: TLabel;
    LabelYear: TLabel;
    ButtonNextYear: TButton;
    ButtonPrevYear: TButton;
    ButtonNextMonth: TButton;
    ButtonPrevMonth: TButton;
    ButtonNextWeek: TButton;
    ButtonPrevWeek: TButton;
    ButtonToday: TButton;
    ButtonGo: TButton;
    ButtonTomorrow: TButton;
    ButtonYesterday: TButton;
    ButtonThisweek: TButton;
    ButtonThisMonth: TButton;
    ButtonNextM: TButton;
    ButtonLastMonth: TButton;
    ButtonNextW: TButton;
    ButtonLastWeek: TButton;
    EditYear: TEdit;
    ListBoxYE: TListBox;
    Label2: TLabel;
    ButtonAdd: TButton;
    ButtonDelete: TButton;
    ButtonSave: TButton;
    ButtonLoad: TButton;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    EditMonth: TEdit;
    EditMonthday: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    EditWeek: TEdit;
    ComboBoxWeekday: TComboBox;
    Label12: TLabel;
    ButtonEdit: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ComboBoxFirstWd: TComboBox;
    Label13: TLabel;
    Kronos1: TKronos;
    RGEvents: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Kronos1ChangeYear(Sender: TObject);
    procedure Kronos1ChangeMonthNumber(Sender: TObject);
    procedure ButtonNextYearClick(Sender: TObject);
    procedure ButtonPrevYearClick(Sender: TObject);
    procedure ButtonNextMonthClick(Sender: TObject);
    procedure ButtonPrevMonthClick(Sender: TObject);
    procedure ButtonTodayClick(Sender: TObject);
    procedure DrawGrid1SelectCell(Sender: TObject; Col, Row: Integer;
      var CanSelect: Boolean);
    procedure Kronos1ChangeMonth(Sender: TObject);
    procedure Kronos1ChangeMonthDay(Sender: TObject);
    procedure ButtonNextWeekClick(Sender: TObject);
    procedure ButtonPrevWeekClick(Sender: TObject);
    procedure ButtonGoClick(Sender: TObject);
    procedure ButtonTomorrowClick(Sender: TObject);
    procedure ButtonYesterdayClick(Sender: TObject);
    procedure ButtonThisweekClick(Sender: TObject);
    procedure ButtonThisMonthClick(Sender: TObject);
    procedure ButtonNextMClick(Sender: TObject);
    procedure ButtonLastMonthClick(Sender: TObject);
    procedure ButtonNextWClick(Sender: TObject);
    procedure ButtonLastWeekClick(Sender: TObject);
    procedure ListBoxYEDblClick(Sender: TObject);
    procedure ComboBoxWeekdayKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonDeleteClick(Sender: TObject);
    procedure ButtonEditClick(Sender: TObject);
    procedure ButtonSaveClick(Sender: TObject);
    procedure ButtonLoadClick(Sender: TObject);
    procedure ComboBoxFirstWdChange(Sender: TObject);
    procedure RGEventsClick(Sender: TObject);
    procedure Kronos1ChangeDate(Sender: TObject);
    procedure Kronos1CalcDaytype(Sender: TObject; Daytype: TDaytype;
      ADateExt: TDateExt; IsCurrentDate: Boolean; var Accept: Boolean);
  private
    { Private declarations }
    SelCol, SelRow : Longint;
    CalcDay : Integer;
    procedure ListEvents;
  public
    { Public declarations }
    UserDay : TDaytypeDef;
  end;

var
  Form1: TForm1;

implementation
uses Daytype;

{$R *.DFM}

procedure InvalidateCell(Grid : TDrawGrid; C, R : integer;
Erase : boolean);
var
   Rect : Trect;
begin
     with Grid do
     begin
          Rect := CellRect(C, R);
          InvalidateRect(Handle, @Rect, Erase);
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     with Kronos1 do
     begin
          GetMIDayCell(DayNumber, SelRow, SelCol);
          ComboBoxFirstWd.ItemIndex := Ord(FirstWeekday);
          LoadFromFile('authors.kdt', true);
     end;
     with DrawGrid1 do
     begin
          ColWidths[0] := 40;
          Rowheights[0] := 20;
     end;
     Kronos1.ReChange;
end;

procedure TForm1.ListEvents;
// Fill the Year events list
var
   I, J : integer;
   DateInf : TDateExt;
   Daytype : TDaytype;
   S : string;
begin
     ListBoxYe.Clear;

     if RGEvents.ItemIndex = 1 then
     with Kronos1 do
     begin
          DateInf := FetchDateExtDn(Year, Daynumber);
          for J := 1 to DateInf.DaytypeCount do
          begin
               Daytype := FetchDaytype(DateInf, J);
               S := Daytype.TheName;
               ListboxYe.Items.AddObject(S, Daytype);
          end;
          exit;
     end;

     for I := 1 to Kronos1.YearExt.YearTypeCount do
     begin
          with Kronos1 do
          begin
               DayType := FetchYeartype(YearExt, I);
               S := IntToStr(Year - Daytype.FirstShowUp) + ' ' +
               'years since ' + Daytype.TheName;
          end;
          ListboxYe.Items.AddObject(S, Daytype);
     end;
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
{Most of the code here is concerned with drawing graphics. Calendaric
data is very simply extracted from the Kronos Component}

   procedure WriteDayType(DayInf : TDateExt);
   //Extracting daytypes connected to a date
   var
      i : integer;
      OldSize : integer;
      OldName : TFontName;
      DT : TDayType;
      FirstWord, SecondWord : string;
      FirstWordIndex : integer;
      S : string;
   begin
        with DrawGrid1.Canvas do
        begin
             OldSize := Font.Size;
             OldName := Font.Name;
             Font.Name := 'Arial';
             Font.Size := 7;
        end;

        with Kronos1 do
        begin
             for i := 1 to DayInf.DaytypeCount do
             begin
                  DT := FetchDaytype(DayInf,1);
                  S := DT.TheName;
                  FirstWordIndex := Pos(' ', S);
                  if FirstWordIndex <> 0 then
                  begin
                     FirstWord := copy(S, 1, FirstWordIndex - 1);
                     SecondWord := copy(S, FirstWordIndex + 1,
                     Length(S) - FirstWordIndex);
                  end
                  else
                  begin
                     FirstWord := '';
                     SecondWord := Dt.TheName;
                  end;
                  if DrawGrid1.Canvas.TextWidth(S) >
                  (DrawGrid1.DefaultColWidth - 25) then
                  begin
                       DrawGrid1.Canvas.TextOut(Rect.Left + 22, Rect.Top + 3,
                       FirstWord);
                       DrawGrid1.Canvas.TextOut(Rect.Left + 22, Rect.Top + 15,
                       SecondWord);
                  end
                  else
                      DrawGrid1.Canvas.TextOut(Rect.Left + 22, Rect.Top + 3,
                      S);
                  break;
             end;
             {Extract and print the first daytype, if any}
        end;
        DrawGrid1.Canvas.Font.Size := OldSize;
        DrawGrid1.Canvas.Font.Name := OldName;
   end;

   procedure WriteWeekCaption;
   // Write 'Week' in upper left corner
   begin
          with DrawGrid1.Canvas do
          begin
               Brush.Color := clAqua;
               Font.Color := clBlue;
               FillRect(Rect);
               TextOut(Rect.Left+5,Rect.Top+2,'Week');
          end;
   end;

   procedure WriteDayname;
   // Write dayname in first row
   var
      NameIndex : word;
      DName : string;
   begin
          NameIndex := Kronos1.DOWtoDayNameIndex(Col);
          // Get index to use with the Daynames-array
          DName := Kronos1.DayNames[NameIndex];
          DName[1] := Upcase(DName[1]);
          with DrawGrid1.Canvas do
          begin
               Brush.Color := clAqua;
               Font.Color := clBlue;
               FillRect(Rect);
          end;
          DrawGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top+2,Dname);
   end;

   procedure WriteWeeknumber;
   var
      WeekNo : string;
   begin
          WeekNo := IntToStr
          (Abs(Kronos1.MonthExt.MonthImage[Row,Col]));
          //Weeknumber is read directly from the month image structure
          with DrawGrid1.Canvas do
          begin
               Brush.Color := clAqua;
               Font.Color := clBlack;
               FillRect(Rect);
          end;
          DrawGrid1.Canvas.TextOut(Rect.Left+5,Rect.Top+2,WeekNo);
   end;

   procedure WriteMonthday;
   var
      MonthD : string;
      BoundMonth : boolean;
      Dnr : smallint;
      DayInf : TDateExt;
   begin
          BoundMonth := false;
          with Kronos1 do
          begin
               MonthD := '';
               Dnr := MonthExt.MonthImage[Row,Col];
               if Dnr < 0 then // Date from bounding months has neg. numbers
               begin
                    MonthD := IntToStr(Abs(Dnr));
                    BoundMonth := true;
               end
               else if Dnr > 0 then
               begin // Daynumber from actual month
                    DayInf := FetchDateExtDn(Year, Dnr);
                    {Get DateExt using the daynumber i the month image cell.
                    The rows and cols in the grid corresponds to the
                    rows and cols in the month image structure}
                    MonthD := IntToStr(DayInf.MonthDay);
               end;
               if (Col = SelCol) and (Row = SelRow) then
               with DrawGrid1.Canvas do
               begin
                     Brush.Color := clBlue;
                     Font.Color := clWhite;
               end
               else if BoundMonth then
               with DrawGrid1.Canvas do
               // Paint days from bounding months in gray
               begin
                    Brush.Color := clSilver;
                    Font.Color := clGray;
               end
               else if DayInf.Holiday then
               with DrawGrid1.Canvas do
               // Paint holidays red
               begin
                    Brush.Color := clSilver;
                    Font.Color := clMaroon;
               end
               else with DrawGrid1.Canvas do
               // Paint normal days blue
               begin
                    Brush.Color := clSilver;
                    Font.Color := clBlue;
               end;

               with DrawGrid1.Canvas do
               begin
                    Font.Style := [fsBold];
                    FillRect(Rect);
                    TextOut(Rect.Left+5,Rect.Top+2,MonthD);
                    Font.Style := [];
               end;

               // Write first daytype, if any
               if DNr > 0 then
                  if DayInf.DaytypeCount > 0 then
                     WriteDayType(DayInf);
          end;
   end;

begin
     if (Row = 0) and (Col = 0) then
        WriteWeekCaption
     else if (Row = 0) and (Col > 0) then
        WriteDayname
     else if (Row > 0) and (Col = 0) then
        WriteWeeknumber
     else if (Row > 0) and (Col > 0) then
        WriteMonthday;

     //Draw monthday rectangle
     with DrawGrid1.Canvas do
     begin
          Pen.Color := clBlack;
          Pen.Width := 1;
          Brush.Style := bsClear;
          Rectangle(Rect.Left+1,Rect.Top+1, Rect.Right-1,
          Rect.Bottom-1);
          Brush.Style := bsSolid;
     end;
end;

procedure TForm1.ButtonNextYearClick(Sender: TObject);
begin
     with Kronos1 do
     Year := Year + 1;
end;

procedure TForm1.ButtonPrevYearClick(Sender: TObject);
begin
     with Kronos1 do
     Year := Year - 1;
end;

procedure TForm1.ButtonNextMonthClick(Sender: TObject);
begin
     with Kronos1 do
          GotoOffsetMonth(1);
end;

procedure TForm1.ButtonPrevMonthClick(Sender: TObject);
begin
     with Kronos1 do
          GotoOffsetMonth(-1);
end;

procedure TForm1.ButtonTodayClick(Sender: TObject);
begin
     Kronos1.GotoToday;
end;

procedure TForm1.DrawGrid1SelectCell(Sender: TObject; Col, Row: Integer;
  var CanSelect: Boolean);
begin
     with Kronos1 do
     if (Row = 0) or (Col = 0)
     or (Row > MonthExt.NumWeeks)
     or (MonthExt.MonthImage[Row, Col] < 1) then
     begin
          CanSelect := false;
          exit;
     end;
     with Kronos1 do
       Daynumber := MonthExt.MonthImage[Row,Col];
end;

procedure TForm1.ButtonNextWeekClick(Sender: TObject);
begin
     Kronos1.GotoOffsetWeek(1);
end;

procedure TForm1.ButtonPrevWeekClick(Sender: TObject);
begin
     Kronos1.GotoOffsetWeek(-1);
end;

procedure TForm1.ButtonGoClick(Sender: TObject);
var
   Y,M,Md,W : word;
   Wd : TWeekday;
   WdSet : boolean;
begin
     WdSet := true;
     if EditYear.Text <> '' then
        Y := StrToInt(EditYear.Text)
     else
        Y := 0;
     if EditMonth.Text <> '' then
        M := StrToInt(EditMonth.Text)
     else
        M := 0;
     if EditWeek.Text <> '' then
        W := StrToInt(EditWeek.Text)
     else
        W := 0;
     if EditMonthday.Text <> '' then
        Md := StrToInt(EditMonthday.Text)
     else
        Md := 0;
     if ComboboxWeekDay.ItemIndex <> -1 then
        Wd := TWeekday(ComboboxWeekDay.ItemIndex)
     else
        WdSet := false;

     with Kronos1 do
     begin
          BeginChange;
          try
             if Y <> 0 then
                Year := Y;
             if M <> 0 then
                Month := M;
             if W <> 0 then
                Week := W;
             if Md <> 0 then
                Monthday := Md;
             if WdSet then
                WeekDay := Wd;
          finally
             EndChange;
          end;
     end;
end;

procedure TForm1.ButtonTomorrowClick(Sender: TObject);
begin
     Kronos1.GotoTomorrow;
end;

procedure TForm1.ButtonYesterdayClick(Sender: TObject);
begin
     Kronos1.GoToYesterday;
end;

procedure TForm1.ButtonThisweekClick(Sender: TObject);
begin
     Kronos1.GotoThisWeek;
end;

procedure TForm1.ButtonThisMonthClick(Sender: TObject);
begin
     Kronos1.GotoThisMonth;
end;

procedure TForm1.ButtonNextMClick(Sender: TObject);
begin
     Kronos1.GotoNextMonth;
end;

procedure TForm1.ButtonLastMonthClick(Sender: TObject);
begin
     Kronos1.GotoLastMonth;
end;

procedure TForm1.ButtonNextWClick(Sender: TObject);
begin
     Kronos1.GotoNextWeek;
end;

procedure TForm1.ButtonLastWeekClick(Sender: TObject);
begin
     Kronos1.GotoLastWeek;
end;

procedure TForm1.ListBoxYEDblClick(Sender: TObject);
var
   Daytypename : string;
   Ind : integer;
begin
     Ind := 0;
     with ListBoxYe do
        Daytypename := Items[ItemIndex];
     Ind := Pos('birth of',Daytypename);
     if Ind <> 0 then
        exit
     else
     begin
         Ind := Pos('death of',Daytypename);
         if Ind <> 0 then
            exit;
     end;
     Kronos1.GotoDayType(Kronos1.Year,0,DayTypeName);
end;

procedure TForm1.ComboBoxWeekdayKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     if Key = VK_Escape then
        ComboBoxWeekday.ItemIndex := -1;
end;

procedure TForm1.ButtonAddClick(Sender: TObject);
begin
     ListBoxYe.ItemIndex := -1;
     Application.CreateForm(TDaytypeDlg, DayTypeDlg);
     if DayTypeDlg.ShowModal = mrOk then
     begin
          Kronos1.AddDaytype(TDaytype.Create(Userday));
          Kronos1.UpdateInfo;
          DrawGrid1.Refresh;
          ListEvents;
     end;

end;

procedure TForm1.ButtonDeleteClick(Sender: TObject);
var
   DayType : TDaytype;
begin
     if ListBoxYe.ItemIndex = -1 then
     begin
          ShowMessage('No daytype selected');
          exit;
     end;
     Daytype := TDayType(ListBoxYe.Items.Objects[ListboxYe.ItemIndex]);
     if Daytype.Id < Kronos1.FirstUserId then
     begin
        ShowMessage('Daytype is not userdefined');
     end
     else
     begin
          Kronos1.DeleteUserDaytype(Daytype.ID,'');
          DrawGrid1.Refresh;
          ListEvents;
     end;
end;

procedure TForm1.ButtonEditClick(Sender: TObject);
var
   Daytype : TDaytype;
begin
     if ListBoxYe.ItemIndex = -1 then
     begin
          ShowMessage('No daytype selected');
          exit;
     end;

     Daytype := TDaytype(ListBoxYe.Items.Objects[ListboxYe.ItemIndex]);
     if Daytype.Id < Kronos1.FirstUserId then
     begin
        ShowMessage('Daytype is not userdefined');
     end;

     Userday := Kronos1.GetDaytypeDef(Daytype.Id,'');
     Application.CreateForm(TDaytypeDlg, DayTypeDlg);
     if DayTypeDlg.ShowModal = mrOk then
     begin
          Kronos1.UpdateDaytype(Daytype.ID,'',Userday);
          Kronos1.UpdateInfo;
          DrawGrid1.Refresh;
          ListEvents;
     end;
end;

procedure TForm1.ButtonSaveClick(Sender: TObject);
begin
     if SaveDialog1.Execute then
     begin
          Kronos1.SaveToFile(Savedialog1.FileName);
     end;
end;

procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
     If OpenDialog1.Execute then
     begin
          Kronos1.LoadfromFile(OpenDialog1.Filename, true);
          Drawgrid1.Refresh;
          ListEvents;
     end;
end;

procedure TForm1.ComboBoxFirstWdChange(Sender: TObject);
var
   R, C : integer;
begin
     Kronos1.FirstWeekDay := Tweekday(ComboBoxFirstWd.ItemIndex);
     Kronos1.GetMIDayCell(Kronos1.Daynumber,R, C);
     if (R <> SelRow) or (C <> SelCol) then
     begin
          SelRow := R;
          SelCol := C;
     end;
     Drawgrid1.Refresh;
end;

procedure TForm1.RGEventsClick(Sender: TObject);
begin
     ListEvents;
end;

{************************** Kronos Event handling**************************}

procedure TForm1.Kronos1ChangeYear(Sender: TObject);
{Change year caption when year changes}
begin
     LabelYear.Caption := IntToStr(Kronos1.Year);
     ListEvents;
end;

procedure TForm1.Kronos1ChangeMonthNumber(Sender: TObject);
{Change month caption when month changes}
begin
     LabelMonthName.Caption := Kronos1.MonthExt.MonthName;
end;

procedure TForm1.Kronos1ChangeMonth(Sender: TObject);
var
   R, C : Longint;
   DExt : TDateExt;
begin
     Kronos1.GetMIDayCell(Kronos1.DayNumber, SelRow, SelCol);
     //Find last Friday of month to use with the OnCalcDaytype
     Kronos1.GetLastMIDayCell(R,C);
     with Kronos1.MonthExt do
     begin
          CalcDay := MonthImage[R,C];
          while Kronos1.DowToWeekDay(C) <> Friday do
          begin
               dec(CalcDay);
               Kronos1.GetMIDayCell(CalcDay, R, C);
          end;
          // If last Friday is holiday, move backwards to first none holiday
          DExt := Kronos1.FetchDateExtDn(Year, CalcDay);
          while DExt.Holiday do
          begin
               dec(CalcDay);
               DExt := Kronos1.FetchDateExtDn(Year,CalcDay);
          end;
     end;
     DrawGrid1.Refresh;
end;

procedure TForm1.Kronos1ChangeMonthDay(Sender: TObject);
var
   OldSelRow, OldSelCol : integer;
begin
     with Kronos1 do
     begin
          OldSelRow := SelRow;
          OldSelCol := SelCol;
          GetMIDayCell(DayNumber, SelRow, SelCol);
          InvalidateCell(DrawGrid1, OldSelCol, OldSelRow, False);
          InvalidateCell(DrawGrid1, SelCol, SelRow, False);
     end;
end;

procedure TForm1.Kronos1ChangeDate(Sender: TObject);
begin
     ListEvents;
end;

procedure TForm1.Kronos1CalcDaytype(Sender: TObject; Daytype: TDaytype;
  ADateExt: TDateExt; IsCurrentDate: Boolean; var Accept: Boolean);
begin
{Calculate 'My calcday'. Value of calcday is set in OnMonthChange
event handler}
     Accept := (ADateExt.DayNumber = CalcDay);
end;

end.